<%
'=========================================================
 '类名: AnUpLoad(艾恩无组件上传类)
 '作者: Anlige
 '版本: 艾恩ASP无组件上传类V11.03.25
 '开发日期: 2008-4-12
 '修改日期: 2011-03025
 '主页: http://dev.mo.cn
 'userEmail: zhanghuiguoanlige@126.com
 'QQ: 1034555083
'=========================================================
dim StreamT
class AnUpLoad
	private Form, Fils, vFileDir, vCharSet, vMaxSize, vSingleSize, verr, vVersion, vTotalSize, vExe
	private pID, vOP, verrExe, vboundary, vLostTime, vMode, vFileCount

	'==============================
	'设置和读取属性开始
	'==============================
	public Property Let Mode(ByVal Value)
		vMode = Value
	End Property
	public Property Let MaxSize(ByVal Value)
		vMaxSize = Value
	End Property
	public Property Let SingleSize(ByVal Value)
		vSingleSize = Value
	End Property
	public Property Let Exe(ByVal Value)
		vExe = lcase(Value)
	End Property
	public Property Let CharSet(ByVal Value)
		vcharset = Value
	End Property
	public Property Get errorID()
		errorID = verr
	End Property
	public Property Get FileCount()
		FileCount = Fils.count
	End Property
	public Property Get description()
		description = Geterr(verr)
	End Property
	public Property Get Version()
		Version = vVersion
	End Property
	public Property Get TotalSize()
		TotalSize = vTotalSize
	End Property
	public Property Get ProcessID()
		ProcessID = pID
	End Property
	public Property Let openProcesser(ByVal Value)
		vOP = Value
	End Property
	public Property Get LostTime()
		LostTime = vLostTime
	End Property
	public Property Let FileDir(ByVal Value)
		vFileDir = Value
	End Property
	'==============================
	'设置和读取属性结束，初始化类
	'==============================
	private sub class_Initialize()
		set Form = server.createobject("Scripting.Dictionary")
		set Fils = server.createobject("Scripting.Dictionary")
		set StreamT = server.createObject("adodb.stream")
		vVersion = "艾恩ASP无组件上传类V10.10.22"
		vMaxSize = -1
		vSingleSize = -1
		verr = -1
		vExe = ""
		vTotalSize = 0
		vcharset = "utf-8"
		vOP = false
		pID = "AnUpload"
		setApp "", 0, 0, ""
		vMode = 0
	End sub
	private sub class_Terminate()
		dim f
		Form.removeAll()
		for each f in Fils
			Fils(f).Value = empty
			set Fils(f) = nothing
		next
		Fils.removeAll()
		set Form = nothing
		set Fils = nothing
		StreamT.close()
		set StreamT = nothing
	End sub

	'==============================
	'函数名:GetData
	'作用:处理客户端提交来的所有数据
	'==============================
	public sub GetData()
		dim time1
		time1 = timer()
		if vOP and trim(request("processid")) <> "" then pID = request("processid")
		dim Value, str, bcrlf, fpos, ssplit, slen, istart,ef
		dim TotalBytes,tempdata,BytesRead,ChunkReadSize,PartSize,DataPart,formend, formhead, startpos, endpos
		dim formname, fileName, NewName, fileExe, Valueend, localname, type_1, contentType
		TotalBytes = request.TotalBytes
		ef = false
		if checkEntryType = false then ef = true : verr = 2
		'下面3句注释掉了，因为在IIS5.0中，如果上传大小大于限制大小的文件，会出错，一直没找到解决方法。如果是在IIS5以上的版本使用，可以取消下面3句的注释
		'if not ef then
			'if vMaxSize > 0 and TotalBytes > vMaxSize then ef = true : verr = 1
		'end if
		if ef then exit sub
		if vMode = 0 then
			vTotalSize = 0
			StreamT.type = 1
			StreamT.mode = 3
			StreamT.open
			BytesRead = 0
			ChunkReadSize = 1024 * 16
			do while BytesRead < TotalBytes
				PartSize = ChunkReadSize
				if PartSize + BytesRead > TotalBytes then PartSize = TotalBytes - BytesRead
				DataPart = request.BinaryRead(PartSize)
				StreamT.write DataPart
				BytesRead = BytesRead + PartSize
				setApp "uploading", TotalBytes, BytesRead, ""
			loop
			setApp "uploaded", TotalBytes, BytesRead, ""
			StreamT.position = 0
			tempdata = StreamT.Read
		else
			tempdata = request.BinaryRead(TotalBytes)
		end if
		bcrlf = ChrB(13) & ChrB(10)
		fpos = inStrB(1, tempdata, bcrlf)
        ssplit = MidB(tempdata, 1, fpos - 1)
		slen = LenB(ssplit)
		istart = slen + 2
        Do
            formend = inStrB(istart, tempdata, bcrlf & bcrlf)
            formhead = MidB(tempdata, istart, formend - istart)
            str = Bytes2Str(formhead)
            startpos = inStr(str, "name=""") + 6
            endpos = inStr(startpos, str, """")
            formname = lcase(mid(str, startpos, endpos - startpos))
            Valueend = inStrB(formend + 3, tempdata, ssplit)
			if inStr(str, "filename=""") > 0 then
				startpos = inStr(str, "filename=""") + 10
				endpos = inStr(startpos, str, """")
				type_1 = inStr(endpos,lcase(str),"content-type")
				contentType = trim(mid(str,type_1 + 13))
				fileName = mid(str, startpos, endpos - startpos)
				if trim(fileName) <> "" then
					LocalName = fileName
					fileName = replace(fileName, "/", "\")
					fileName = mid(fileName, inStrRev(fileName, "\") + 1)
					if inStr(fileName, ".") > 0 then
						fileExe = split(fileName, ".")(ubound(split(fileName, ".")))
					else
						fileExe = ""
					end if
					if vExe <> "" then '判断扩展名
						if checkExe(fileExe) = true then
							verr = 3
							verrExe = fileExe
							tempdata = Empty
							exit sub
						end if
					end if
					NewName = GetName()
                    NewName = NewName & "." & fileExe
					vTotalSize = vTotalSize + Valueend - formend - 6
					if vSingleSize > 0 and (Valueend - formend - 6) > vSingleSize then '判断上传单个文件大小
						verr = 5
						tempdata = empty
						exit sub
					end if
					if vMaxSize > 0 and vTotalSize > vMaxSize then '判断上传数据总大小
						verr = 1
						tempdata = empty
						exit sub
					end if
					if Fils.Exists(formname) then
						verr = 4
						tempdata = empty
						exit sub
					else
						dim fileCls
						set fileCls = new UploadFileEx
						fileCls.contentType = contentType
						fileCls.Size = (Valueend - formend - 6)
						fileCls.position = (formend + 3)
						fileCls.formName = formname
						fileCls.NewName = NewName
						fileCls.fileName = fileName
						fileCls.LocalName = fileName
						fileCls.extend = split(NewName,".")(Ubound(split(NewName,".")))
						Fils.Add formname, fileCls
						set fileCls = nothing
					end if
				end if
			else
				Value = MidB(tempdata, formend + 4, Valueend - formend - 6)
				if Form.Exists(formname) then
					Form(formname) = Form(formname) & "," & Bytes2Str(Value)
				else
					Form.Add formname, Bytes2Str(Value)
				end if
			end if
            istart = Valueend + 2 + slen
        loop Until (istart + 2) >= LenB(tempdata)
		verr = 0
		tempdata = Empty
		vLostTime = formatNumber((Timer - time1) * 1000, 2)
	End sub

	public sub setApp(stp,total,current,desc)
		application.lock()
		application(pID) = "{id:""" & pID & """,step:""" & stp & """,total:" & total & ",now:" & current & ",description:""" & desc & """,dt:""" & now() & """}"
		application.unLock()
	end sub
	'==============================
	'判断扩展名
	'==============================
	private function checkExe(ByVal ex)
		dim notIn: notIn = true
		if vExe = "*" then
			notIn = false
		elseif inStr(1, vExe, "|") > 0 then
			dim tempExe: tempExe = split(vExe, "|")
			dim I: I = 0
			for I = 0 to ubound(tempExe)
				if lcase(ex) = tempExe(I) then
					notIn = false
					exit for
				end if
			next
		else
			if vExe = lcase(ex) then
				notIn = false
			end if
		end if
		checkExe = notIn
	end function

	'==============================
	'把数字转换为文件大小显示方式
	'==============================
	public function GetSize(ByVal Size)
		if Size < 1024 then
			GetSize = formatNumber(Size, 2) & "B"
		elseif Size >= 1024 and Size < 1048576 then
			GetSize = formatNumber(Size / 1024, 2) & "KB"
		elseif Size >= 1048576 then
			GetSize = formatNumber((Size / 1024) / 1024, 2) & "MB"
		end if
	end function

	'==============================
	'二进制数据转换为字符
	'==============================
	private function Bytes2Str(ByVal byt)
		if LenB(byt) = 0 then
			Bytes2Str = ""
			exit function
		end if
		dim mystream, bstr
		set mystream = server.createobject("ADODB.Stream")
		mystream.type = 2
		mystream.mode = 3
		mystream.open
		mystream.writeText byt
		mystream.position = 0
		mystream.charset = vCharSet
		mystream.position = 2
		bstr = mystream.ReadText()
		mystream.close
		set mystream = nothing
		Bytes2Str = bstr
	end function

	'==============================
	'获取错误描述
	'==============================
	private function Geterr(ByVal Num)
		select case Num
			case 0
				Geterr = "数据处理完毕!"
			case 1
				Geterr = "上传数据超过" & GetSize(vMaxSize) & "限制!可设置MaxSize属性来改变限制!"
			case 2
				Geterr = "未设置上传表单enctype属性为multipart/form-data或者未设置method属性为Post,上传无效!"
			case 3
				Geterr = "含有非法扩展名(" & verrExe & ")文件!只能上传扩展名为" & replace(vExe, "|", ",") & "的文件"
			case 4
				Geterr = "对不起,程序不允许使用相同name属性的文件域!"
			case 5
				Geterr = "单个文件大小超出" & GetSize(vSingleSize) & "的上传限制!"
		end select
	end function

	'==============================
	'根据日期生成随机文件名
	'==============================
	private function GetName()
		dim y, m, d, h, mm, S, r, n
		randomize
		y = year(now)
		m = right("0" & month(now), 2)
		d = right("0" & day(now), 2)
		h = right("0" & hour(now), 2)
		mm = right("0" & minute(now), 2)
		S = right("0" & second(now), 2)
		r = 0
		r = CInt(Rnd() * 1000)
		n = right("0" & r, 4)
		Getname = y & m & d & h & mm & S & n
	end function

	'==============================
	'检测上传类型是否为multipart/form-data
	'==============================
	private function checkEntryType()
		dim contentType, ctArray, bArray,requestMethod
		requestMethod = trim(lcase(request.serverVariables("request_METHOD")))
		if requestMethod = "" or requestMethod <> "post" then
			checkEntryType = false
			exit function
		End if
		contentType = lcase(request.serverVariables("HTTP_CONTENT_TYPE"))
		ctArray = split(contentType, ";")
		if ubound(ctarray) >= 0 then
			if trim(ctArray(0)) = "multipart/form-data" then
			checkEntryType = true
			vboundary = split(contentType,"boundary=")(1)
			else
			checkEntryType = false
			end if
		else
			checkEntryType = false
		end if
	end function

	'==============================
	'获取上传表单值,参数可选,如果为-1则返回一个包含所有表单项的一个dictionary对象
	'==============================
	public function Forms(ByVal formname)
		if trim(formname) = "-1" then
			set Forms = Form
		else
			if Form.Exists(lcase(formname)) then
				Forms = Form(lcase(formname))
			else
				Forms = ""
			end if
		end if
	end function

	'==============================
	'获取上传的文件类,参数可选,如果为-1则返回一个包含所有上传文件类的一个dictionary对象
	'==============================
	public function Files(ByVal formname)
		if trim(formname) = "-1" then
			set Files = Fils
		else
			if Fils.Exists(lcase(formname)) then
				set Files = Fils(lcase(formname))
			else
				set Files = nothing
			end if
		end if
	end function
end class

class UploadFileEx
	private mvarFormName, mvarNewName, mvarLocalName, mvarFileName, mvarUserSetName, mvarContentType, mException, mvarPosition
	private mvarSize, mvarValue, mvarPath, mvarExtend, mvarWidth, mvarHeight

	public Property Let Extend(ByVal vData )
		mvarExtend = vData
	End Property
	public Property Get Extend()
		Extend = mvarExtend
	End Property

	public Property Get Width()
		Width = mvarWidth
	End Property

	public Property Get Height()
		Height = mvarHeight
	End Property

	public Property Let Path(ByVal vData )
		mvarPath = vData
	End Property
	public Property Get Path()
		Path = mvarPath
	End Property

	public Property Get Exception()
		Exception = mException
	End Property

	public Property Let Value(ByVal vData )
		mvarValue = vData
	End Property

	public Property Get Value()
		Value = mvarValue
	End Property

	public Property Let Size(ByVal vData )
		mvarSize = vData
	End Property
	public Property Get Size()
		Size = mvarSize
	End Property

	public Property Let Position(ByVal vData )
		mvarPosition = vData
	End Property
	public Property Get Position()
		Size = mvarPosition
	End Property

	public Property Let contentType(ByVal vData )
		mvarContentType = vData
	End Property
	public Property Get contentType()
		contentType = mvarContentType
	End Property

	public Property Let userSetName(ByVal vData )
		mvarUserSetName = vData
	End Property
	public Property Get userSetName()
		userSetName = mvarUserSetName
	End Property

	public Property Let fileName(ByVal vData )
		mvarFileName = vData
	End Property
	public Property Get fileName()
		fileName = mvarFileName
	End Property

	public Property Let LocalName(ByVal vData )
		mvarLocalName = vData
	End Property
	public Property Get LocalName()
		LocalName = mvarLocalName
	End Property

	public Property Let NewName(ByVal vData)
		mvarNewName = vData
	End Property
	public Property Get NewName()
		NewName = mvarNewName
	End Property

	public Property Let FormName(ByVal vData)
		mvarFormName = vData
	End Property
	public Property Get FormName()
		FormName = mvarFormName
	End Property

	private sub class_Initialize()
		mvarSize = 0
		mvarWidth = 0
		mvarHeight = 0
	End sub

	public function saveToFile(ByVal Path, byval tOption, byval OverWrite)
		on error resume next
		dim isP
		isP = (inStr(Path, ":") = 2)
		if not isP then Path = server.mapPath(Path)
		Path = replace(Path, "/", "\")
		if mid(Path, len(Path) - 1) <> "\" then Path = Path + "\"
		CreateFolder Path
		mvarPath = Path
		if tOption = 1 then
			Path = Path & mvarLocalName
			mvarFileName = mvarLocalName
		else
			if tOption = -1 and mvarUserSetName <> "" then
				Path = Path & mvarUserSetName & "." & mvarExtend
				mvarFileName = mvarUserSetName & "." & mvarExtend
			else
				Path = Path & mvarNewName
				mvarFileName = mvarNewName
			end if
		end if
		if OverWrite = false then Path = GetFilePath()
		dim tmpStrm
		set tmpStrm = server.createObject("ADODB.Stream")
		tmpStrm.mode = 3
		tmpStrm.type = 1
		tmpStrm.open
		StreamT.position = mvarPosition
		StreamT.copyTo tmpStrm, mvarSize
		tmpStrm.saveToFile Path, 2
		tmpStrm.close
		set tmpStrm = nothing
		if not err then
			set saveToFile = objFromJson("{error:false}")
		else
			set saveToFile = objFromJson("{error:true,description:'" & replace(err.description,"'","\'") & "'}")
			mException = err.description
		end if
	end function

	public function GetBytes()
		StreamT.position = mvarPosition
		GetBytes = StreamT.read(mvarSize)
	end function
	private function CreateFolder(ByVal folderPath )
		dim sParent
		sParent = fso.GetParentFolderName(folderPath)
		if sParent = "" then exit function
		if not fso.FolderExists(sParent) then CreateFolder(sParent)
		if not fso.FolderExists(folderPath) then fso.CreateFolder(folderPath)
	end function

	private function GetFilePath()
		dim Fname, FNameL, i
		i = 0
		Fname = mvarPath & mvarFileName
		FNameL = mid(mvarFileName, 1, inStr(mvarFileName, ".") - 1)
		do while fso.fileExists(Fname)
			Fname = mvarPath & FNameL & "_" & i & "." & mvarExtend
			mvarFileName = FNameL & "_" & i & "." & mvarExtend
			i = i + 1
		loop
		GetFilePath = Fname
	end function
end class
%>
<script language="jscript" runat="server">
function objFromJson(str){
	eval("var _temp=(" + str + ");");
	return _temp;
}
</script>